home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / numerical / slatec / xgetua.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  983 b   |  29 lines
  1. ;;; Compiled by f2cl version 2.0 beta 2002-05-06
  2. ;;; 
  3. ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
  4. ;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
  5. ;;;           (:array-slicing nil) (:declare-common nil)
  6. ;;;           (:float-format double-float))
  7.  
  8. (in-package "SLATEC")
  9.  
  10.  
  11. (defun xgetua (iunita n)
  12.   (declare (type f2cl-lib:integer4 n)
  13.            (type (simple-array f2cl-lib:integer4 (*)) iunita))
  14.   (prog ((f2cl-lib:index 0) (i 0))
  15.     (declare (type f2cl-lib:integer4 i f2cl-lib:index))
  16.     (setf n (j4save 5 0 f2cl-lib:%false%))
  17.     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  18.                   ((> i n) nil)
  19.       (tagbody
  20.         (setf f2cl-lib:index (f2cl-lib:int-add i 4))
  21.         (if (= i 1) (setf f2cl-lib:index 3))
  22.         (f2cl-lib:fset (f2cl-lib:fref iunita (i) ((1 5)))
  23.                        (j4save f2cl-lib:index 0 f2cl-lib:%false%))
  24.        label30))
  25.     (go end_label)
  26.    end_label
  27.     (return (values nil n))))
  28.  
  29.